home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vbmidi / midihook.frm < prev    next >
Text File  |  1995-02-04  |  16KB  |  332 lines
  1. VERSION 2.00
  2. Begin Form frmMidiHook 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   3  'Fixed Double
  5.    Caption         =   "Midi Hook"
  6.    ClientHeight    =   615
  7.    ClientLeft      =   645
  8.    ClientTop       =   7725
  9.    ClientWidth     =   2010
  10.    ControlBox      =   0   'False
  11.    Height          =   1020
  12.    Left            =   585
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    MinButton       =   0   'False
  16.    ScaleHeight     =   615
  17.    ScaleWidth      =   2010
  18.    Top             =   7380
  19.    Width           =   2130
  20.    Begin MsgHook MidiHook 
  21.       Left            =   690
  22.       Top             =   120
  23.    End
  24. End
  25. Option Explicit
  26.  
  27. Dim iLoNibble As Integer
  28. Dim iHiNibble As Integer
  29.  
  30. Dim iMtcHours As Integer
  31. Dim iMtcMinutes As Integer
  32. Dim iMtcSeconds As Integer
  33. Dim iMtcFrames  As Integer
  34.  
  35. Sub MidiHook_Message (iMsg As Integer, iRet1 As Integer, lMidiMessage As Long, iRet2 As Integer, lRet3 As Long)
  36.  Dim iMidiStatus As Integer
  37.     Dim iMidiData1 As Integer
  38.     Dim iMidiData2 As Integer
  39.     Dim iMtcData As Integer
  40.     Dim lTotalFrames As Long
  41.  
  42.     'The code inside this Procedure must be selfcontained
  43.     'without calling any other Procedure or DoEvents or Refresh...
  44.     '
  45.     'The whole Procedure execution should not take longer than 8ms.
  46.     '
  47.     'This version seems very long but the program
  48.     'actually only executes a few lines of it
  49.     'based on the Ifs.. and Select Cases... decissions
  50.  
  51.     If iMsg <> MIM_DATA Then Exit Sub    'just for safety
  52.     
  53.     'Unpack lMidiMessage
  54.     iMidiStatus = lMidiMessage And &HFF&            'First byte
  55.     iMidiData1 = (lMidiMessage And &HFF00&) / 256   'Second byte
  56.     iMidiData2 = (lMidiMessage And &HFF0000) / 65536'Third byte
  57.  
  58.     'Filter RealTime Midi Messages except MTC
  59.     If iMidiStatus >= &HF0 And iMidiStatus <> MTC_QFRAME Then Exit Sub
  60.     
  61.     'Filter here any other Status if necessary.
  62.     '(i.e. PITCH_BEND, CHANNEL_PRESSURE, POLY_KEY_PRESS, etc.)
  63.  
  64.     If iMidiStatus = MTC_QFRAME Then    'Hooked message is a MTC quarter frame message
  65.  
  66.  
  67.        'You may show here a screen representation of MTC In.
  68.  
  69.        '********************************************
  70.        'SPECIFIC TO THIS APPLICATION
  71.         If bVisualMtc = True Then
  72.             If frmVBSeq.picMtcIn.BackColor = LED_OFF Then  'If MTC In led is off
  73.                 frmVBSeq.picMtcIn.BackColor = LED_ON       'Switch MTC In led on
  74.             End If
  75.             lMtcInTime = timeGetTime()   'Save current system time for switch off calculations
  76.         End If
  77.        '********************************************
  78.  
  79.  
  80.         If bMTCThru = True Then         'Global Flag
  81.             If hMidiOut <> NO_HANDLE Then    'If iOutDevice Opened...
  82.                 vntRet = midiOutShortMsg(hMidiOut, lMidiMessage)   'send it out
  83.  
  84.  
  85.                'You may show here a screen representation of MTC Out.
  86.  
  87.                '**********************************************
  88.                'SPECIFIC TO THIS APPLICATION
  89.                 If bVisualMtc = True Then
  90.                     If frmVBSeq.picMtcOut.BackColor = LED_OFF Then  'If MTC Out led is off
  91.                         frmVBSeq.picMtcOut.BackColor = LED_ON       'Switch MTC Out led on
  92.                     End If
  93.                     lMtcOutTime = timeGetTime()  'Save current system time for switch off calculations
  94.                 End If
  95.                '**********************************************
  96.  
  97.             End If
  98.         End If
  99.  
  100.         'We're only interested in decoding MTC while we are in external sync
  101.         If nSyncMode = SYNC_EXTERNAL Then
  102.             'MTC Data=Second Byte of lMidiMessage
  103.             iMtcData = iMidiData1
  104.  
  105.             'Quarter Frame Message Identifier=hiNibble of iMtcData
  106.             Select Case (iMtcData And &HF0)
  107.  
  108.                 Case &H0:       'Quarter Frame Message indicating Frames loNibble
  109.                     If nQfIdExpected <> &H0 Then   'Discontinous MTC
  110.                         bInSync = False            'Out of sync
  111.                         nQfIdExpected = &H0        'start over
  112.                     Else
  113.                         'Frames loNibble=loNibble of iMtcData
  114.                         iLoNibble = (iMtcData And &HF)
  115.                         'If we're in sync, increase Time Counter (milliseconds per quarter frame)
  116.                         If bInSync = True Then lMtcTime = lMtcTime + fMsPerQF
  117.                         nQfIdExpected = &H10    'Expected next Quarter Frame Message
  118.                     End If
  119.     
  120.                 Case &H10:        'Quarter Frame Message indicating Frames hiNibble
  121.                     If nQfIdExpected <> &H10 Then   'Discontinous MTC
  122.                         bInSync = False             'Out of sync
  123.                         nQfIdExpected = &H0         'start over
  124.                     Else
  125.                         'Frames hiNibble=Bit 0 of iMtcData
  126.                         iHiNibble = (iMtcData And &H1)
  127.                         iMtcFrames = (iHiNibble * 16) + iLoNibble   'Pack Frame Number
  128.                         'If we're in sync, increase Time Counter
  129.                         If bInSync = True Then lMtcTime = lMtcTime + fMsPerQF
  130.                         nQfIdExpected = &H20     'Expected next Quarter Frame Message
  131.                     End If
  132.     
  133.                 Case &H20:          'Quarter Frame Message indicating seconds loNibble
  134.                     If nQfIdExpected <> &H20 Then   'Discontinous MTC -> resync
  135.                         bInSync = False             'Out of sync
  136.                         nQfIdExpected = &H0         'start over
  137.                     Else
  138.                         'Seconds LoNibble=LoNibble of iMtcData
  139.                         iLoNibble = (iMtcData And &HF)
  140.                         'If we're in sync, increase Time Counter
  141.                         If bInSync = True Then lMtcTime = lMtcTime + fMsPerQF
  142.                         nQfIdExpected = &H30    'Expected next Quarter Frame Message
  143.                     End If
  144.     
  145.                 Case &H30:          'Quarter Frame Message indicating seconds hiNibble
  146.                     If nQfIdExpected <> &H30 Then     'Discontinous MTC -> resync
  147.                         bInSync = False               'Out of sync
  148.                         nQfIdExpected = &H0           'start over
  149.                     Else
  150.                         'Seconds HiNibble=bits 0 & 1 of iMtcData
  151.                         iHiNibble = (iMtcData And &H3)
  152.                         iMtcSeconds = (iHiNibble * 16) + iLoNibble  'pack Seconds Number
  153.                         'If we're in sync...
  154.                         If bInSync = True Then
  155.                             'increase Time Counter
  156.                             lMtcTime = lMtcTime + fMsPerQF
  157.                             '4th quarter frame->Increase Frame Counter
  158.                             nMtcTotalFrames = nMtcTotalFrames + 1
  159.                         End If
  160.                         nQfIdExpected = &H40    'Expected next Quarter Frame Message
  161.                     End If
  162.     
  163.                 Case &H40:           'Quarter Frame Message indicating Minutes iLoNibble
  164.                     If nQfIdExpected <> &H40 Then      'Discontinous MTC -> resync
  165.                         bInSync = False                'Out of sync
  166.                         nQfIdExpected = &H0            'start over
  167.                     Else
  168.                         'Minutes LoNibble=LoNibble of iMtcData
  169.                         iLoNibble = (iMtcData And &HF)
  170.                         'If we're in sync, increase Time Counter
  171.                         If bInSync = True Then lMtcTime = lMtcTime + fMsPerQF
  172.                         nQfIdExpected = &H50    'Expected next Quarter Frame Message
  173.                     End If
  174.     
  175.                 Case &H50:           'Quarter Frame Message indicating Minutes hiNibble
  176.                     If nQfIdExpected <> &H50 Then        'Discontinous MTC -> resync
  177.                         bInSync = False                  'Out of sync
  178.                         nQfIdExpected = &H0              'start over
  179.                     Else
  180.